package Data::Semantic::RegexpAdapter;

use strict;
use warnings;
use Regexp::Common;


our $VERSION = '0.03';


use base qw(
    Data::Semantic
    Data::Inherited
);


__PACKAGE__
    ->mk_scalar_accessors(qw(re))
    ->mk_boolean_accessors(qw(keep))
    ->mk_hash_accessors(qw(kept));


use constant LOAD => '';
use constant REGEXP_KEYS => ();
use constant KEEP_KEYS  => ();


sub init {
    my $self = shift;

    Regexp::Common->import($self->LOAD) if $self->LOAD;

    my @regexp_keys = $self->every_list('REGEXP_KEYS');

    @regexp_keys || die "REGEXP_KEYS is not defined";
    my $re_spec = sprintf '$RE%s',
        join '' =>
        map { "{$_}" }
        @regexp_keys, $self->flags;
    my $re = eval $re_spec;
    die $@ if $@;

    $self->re($re);
}


# turn the object's settings into a list of flags to be passed to
# Regexp::Common's $RE

sub flags {
    my $self = shift;
    my @flags;
    push @flags => '-keep' if $self->keep;
    @flags;

}


sub is_valid_normalized_value {
    my ($self, $value) = @_;
    my $re = $self->re;
    my $ok = $value =~ /^$re$/;

    # assume {-keep} was given in any case - the user will know whether kept()
    # will return anything useful.

    my %keep;
    @keep{ $self->KEEP_KEYS } =
        map { defined($_) ? $_ : '' }
        ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10);
    $self->kept(%keep);

    $ok;
}


1;


__END__

{% USE p = PodGenerated %}

=head1 NAME

{% p.package %} - Adapter for Regexp::Common patterns

=head1 SYNOPSIS

    {% p.package %}->new;

=head1 DESCRIPTION

This class is an adapter (wrapper) that turns L<Regexp::Common> patterns into
Data::Semantic objects.

=head1 METHODS

=over 4

{% p.write_methods %}

=item LOAD

    use constant LOAD => 'AT::NICAT';

This is the optional name of the Regexp::Common module to load. For example,
if you use a pattern from L<Regexp::Common::AT::NICAT>, you would set this
to C<AT::NICAT>. If you use patterns bundled in the same distribution as
Regexp::Common you can leave it empty.

=item REGEXP_KEYS

    use constant REGEXP_KEYS => qw(URI file);

These is the list of keys that you would pass to Regexp::Common's C<$RE>. For
example, if you wanted to match HTTP URIs, you would use C<qw(URI HTTP)>.
Compare with L<Regexp::Common::URI::http>. See L<Regexp::Common> for more
details on this mechanism.

=item KEEP_KEYS

    use constant KEEP_KEYS => qw(scheme host port query);

This class supports Regexp::Common's C<-keep> mechanism. C<kept()> returns a
hash of the patterns returned by Regexp::Common. In this list you can specify
the hash keys that C<$1>, C<$2> and so on are mapped to.

=item flags

Turns the object's settings into a list of flags to be passed to
Regexp::Common's C<$RE>. For example, Regexp::Common expects a C<{-keep}> key,
but this class has a C<keep()> accessor. If you subclass this class and
add more accessors that correspond to Regexp::Common keys, you need to
override this method and map the attributes to the keys. Be sure to call
C<SUPER::flags()>. See L<Data::Semantic::URI::http> for an example.

=back

{% p.write_inheritance %}

{% PROCESS standard_pod %}

=cut

